#!/usr/bin/perl
#
# Take E-mail to the Linux Counter and process it
# Note: expects to be run via "runscript", and find itself in the
# "right" directory and path at once.
#
use Fcntl;

use strict;
# Things that we know have to be global
use vars qw($EX_TEMPFAIL %donotsendto $maintainer $prefix $user);
use vars qw($logprefix $debug $lockprefix);
# Things where we're not so sure
use vars qw($opt $date $noemail $waitcount $users %maybeloops);
use vars qw($fromlineofnextmessage $lastinputline $sender $ret $echobuf);
use vars qw($ret $warn $warnmsg $notemailbecause);
use vars qw($replydom $wwwhost $wwwuser);
use vars qw($reportdone $doecho $msg $persons $person $countsas $key $name);
use vars qw($fielderr $valueerr $oldmach $usage %usages);
use vars qw($friends $friendcount $friend);
use vars qw($usergroups $usergroup);
use vars qw($check $file $x $reprocess $filelist @files $secret);
use vars qw($headingprinted);
use vars qw($envelopefrom $headerfrom);

# Failure code. Ought to be in some Use module
$EX_TEMPFAIL = 75;

use FileTable;
use Validate::Persons;
use Validate::Machines;
use Validate::Friends;
use UNIVERSAL qw(isa);
require "isemail.pl";

%donotsendto = (
  "root\@domen.uninett.no", "root",
  "postmaster\@uninett.no", "postmaster",
  "mailer-daemon\@aleph.counter.li.org", "mailer-daemon",
);

$maintainer = "Harald\@alvestrand.no";
# So many mails to this are spam that I do NOT want to see the bounces.
# Should have another envelopefrom for valid registrations, but the
# program structure is not nice for this now.
$envelopefrom = "null\@counter.li.org";
$headerfrom = "linux-counter-errors\@counter.li.org";

#================== PROGRAM STARTS HERE

$prefix = "db/";
$logprefix = "logs/";
if ($0 =~ /test/) {
    $prefix = "test-db/";
    $logprefix = "test-logs/";
}
if ( -t STDIN ) {
    $debug = 1;
    print "Test mode at a terminal. Write the message\n";
} else {
    open(STDERR, ">>$logprefix/emailerrors");
    autoflush STDERR 1;
}
# Locks must be written in a place where the mailer gets write access.
# This is ugly...
$lockprefix = "email/mailerdir";

while ($ARGV[0] =~ /^-/) {
   $opt = shift(@ARGV);
   if ($opt eq "-debug") {
      $debug = 1;
      $prefix = "test-db/";
      $logprefix = "test-logs/";
      print "Test mode\n";
   } elsif ($opt eq "-help") {
      print STDERR "Only writing HELP message\n";
      open(MAILOUT, ">&STDOUT");
      &help;
      exit(0);
  } elsif ($opt eq "-date") {
      $date = shift(@ARGV);
  } elsif ($opt eq "-noemail") {
      $noemail = 1;
  } else {
      print STDERR "Argument $opt not understood\n";
      die "Usage: $0 [-debug] [-help] [-date date] [-noemail]\n";
  }
}

open(EVENTLOG, ">>${logprefix}eventlog") || die "Unable to open eventlog";
autoflush EVENTLOG 1;
# Lock file. Needed to avoid computer meltdown at times...
$waitcount = 0;
while (!sysopen(HANDLE, "$lockprefix/count.LOCK", O_CREAT|O_EXCL|O_RDWR, 0744)) {
    ++ $waitcount;
    if ($waitcount > 10) {
        
        print EVENTLOG ">>>>email/count exiting because of timeout\n";
	$! = $EX_TEMPFAIL;
	exit($EX_TEMPFAIL);
    }
    $0 = "count($waitcount) waiting for lock";
    print STDERR "Sysopen failed: $!\n" if $debug;
    sleep 10;
}
$date = localtime();
print HANDLE "$$\n$date\n";
close HANDLE;
$0 = "count registering";
      

$users = FileTable::open("${prefix}users", O_RDWR|O_CREAT);

srand;

%maybeloops = (
"postmaster", 1,
"root", 1,
"mailer-daemon", 1,
);

&nextline;
while (!$fromlineofnextmessage && $lastinputline) {
   &nextline; # Skip possible initial junk
}
while ($fromlineofnextmessage) {
    if ($fromlineofnextmessage =~ /^From (\S+@\S+) +(.*)\n$/) {
	$sender = $1; $date = $2;
	$fromlineofnextmessage = "";
	print STDERR "Reprocessing $date $sender\n";
	$ret = &onemessage;
	if ($ret) {
	    print STDERR "Skipping lines\n";
	    &nextline;
	}
	# Skip possible junk from a failed or //ENDed message
	while (!$fromlineofnextmessage && $lastinputline) {
	    &nextline; # Skip possible initial junk
	}
    } else {
	die "Input does not look like a message log\n";
    }
}
print STDERR "Fromline = <$fromlineofnextmessage>\n";
print STDERR "Last input = <$lastinputline>\n";

$users->close;
unlink "$lockprefix/count.LOCK";

sub onemessage {
    my($thingsdone, $helpdone, $vote);
    my($replyto, $body);
    $echobuf = "";

    print EVENTLOG "$date: Message from $sender\n";
    while (&nextline) {
	chop;
	if (/^Subject: /i) {
	    $vote = $';
	    # Cleaning up the vote goes here
	    $vote =~ s/^re: //;
	} elsif (/^From: /i) {
	    $replyto = $' if !$replyto;
	} elsif (/^Reply-to: /i) {
	    $replyto = $'; #'
	} elsif (/^$/) {
	    $body = 1;
	    last;
	}
    }
    $replyto =~ s/\s*\([^)]+\)?//; # Remove comments from address 

    # Temp stuff: drop worm-like subject lines
    # Better solution is to drop all > 10 Kbytes mails....
    if ($vote =~ /(Re: Approved|Thank you|Wicked screensaver|Your details|That movie|Re: Details|Re: My details|Your application)/i) {
	print EVENTLOG "Virus: $vote\n";
	return 1;
    }

#------------ FIGURE OUT WHO TO REPLY TO --------------
# I am allowed to forward stuff to it!
    if (($sender =~ /alvestrand\@maxware/i && $replyto !~/alvestrand\@maxware/i)
	|| ($sender =~ /hta@.*kvatro/i && $replyto !~/kvatro/i)) {
	$sender = $replyto;
	print EVENTLOG "operator message; $replyto treated as sender\n";
    }
    if ($replyto) {
	$replyto =~ tr/A-Z/a-z/;
	if ($replyto =~ /<(.*)>/) {
	    $replyto = $1;
	}
	$replyto =~ s/\([^\)]+\)//;
	$replyto =~ s/^\s+//;
	$replyto =~ s/\s+$//;
	if ($replyto ne $sender) {
	    if (&notemail($replyto) && !&notemail($sender)) {
                print EVENTLOG "Ignoring illegal $replyto - reply to $sender\n";
                $warn = 1;
                $warnmsg =
 "NOTE: Your From or Reply-to, $replyto, is illegal; the envelope FROM,
$sender, was used instead for replying";
		$replyto = $sender;
	    } else {
		print EVENTLOG "Reply for $sender sent to $replyto\n";
	    }
	}
    } else {
	$replyto = $sender;
    }
    $0 = "count registering for $replyto";
    
# --------- CHECK ORIGINATOR ADDRESS --------
# Refuse to send mail to some known dangerous addresses
    if (&notemail($replyto)) {
	print EVENTLOG ">>>>>>NOT sending mail to \"$replyto\" - $notemailbecause\n";
	($replydom = $replyto) =~ s/.*@//;
	if ($replyto =~ /localhost/) {
	    # I know this is a silly address; drop it
	    print EVENTLOG ">>>>>>Localhost: Message dropped\n";
	    return 1; # out of onemessage routine
	} elsif ($replyto =~ /^(root|postmaster|mailer-daemon)@/
           || $notemailbecause eq "forbidden address") {
	    # Another joker registering before DNS is setup...aarrgghh...
	    print EVENTLOG ">>>>>>Message from $replyto dropped\n";
            return 1; # out of onemessage routine
	} else {
	    print EVENTLOG ">>>>Message dropped (2)\n";
	    return 1; # from onemessage
	}
    }



# Start sending
    if ($noemail) {
	open(MAILOUT, ">/dev/null");
    } elsif (!$debug) {
	open(MAILOUT, "|/usr/lib/sendmail -f$envelopefrom $replyto") || die "Unable to open sendmail";
	print MAILOUT <<EoF;
From: Linux Counter <$headerfrom>
To: $replyto
Subject: Reply from Linux usage counter

EoF
    } else {
	print STDERR "Not sending mail to $replyto\n";
    }


#-------------- START SENDING THE MESSAGE ------------------

# Body loop
    if ($body) {
	&nextline;
	while ($_) {
# -------------- FIND THE USER ID --------------
	    if ($user && !isa($user, "FileTable::Record")) {
		warn "Someone's messed with user - $user keys ", keys(%{$user}), "\n";
		undef $user;
	    }
	    if (m!^//MACHINE!i) {
		$user = setuser($user, $replyto);
		printheading();
		&machineregistration;
		++ $thingsdone;
	    } elsif (m!^//PERSON!i) {
		$user = setuser($user, $replyto);
		printheading();
		&personregistration;
		++ $thingsdone;
# ----- these 2 tables are no longer in use ------
#	    } elsif (m!^//FRIEND!i) {
#		$user = setuser($user, $replyto);
#		&friendregistration;
#		++ $thingsdone;
#	    } elsif (m!^//USERGROUP!i) {
#		$user = setuser($user, $replyto);
#		&usergroupregistration;
#		++ $thingsdone;
# -------------------------------------------------
	    } elsif (m!^//REPORT\s+!i) {
		&sendreport($');
		++ $thingsdone;
		++ $reportdone;
	    } elsif (m!^(//)?HELP\s*$!i) {
		&help;
		++ $thingsdone;
		++ $helpdone;
		&nextline;
	    } elsif (m!^//END!i) {
		last;
	    } elsif (m!^//ECHO!i) {
		$doecho = 1;
		&nextline;
	    } elsif (! $_) {
		last; # Stop if an EOF has been read by other input routine
	    } else { # Has to be this way to allow registrations to stop at // sign
		&nextline;
	    }
	}
    }
    
    if ($doecho) {
	print MAILOUT "\n\nYour message with all headers as seen from here:\n";
	print MAILOUT "=" x 75, "\n";
	print MAILOUT $echobuf;
	print MAILOUT 
	    "If you included an //END command, the rest of the message is not listed\n";
    }
    
    if ($thingsdone == 0) {
	warn "Thingsdone = 0 - simple registration\n";
	# Simple registration. Make something for the person file
        # note - this is the REALLY old part of the system....

	if ($vote !~ /Linux/i || $vote =~ /linux-counter/i) {
	    print MAILOUT <<EoT;
The subject line of your message was $vote.

This did NOT contain the word "Linux".
The counter has unfortunately been the recipient of many sorts
of messages, some of which were not intended as registrations.
Therefore, the subject line MUST include "Linux" to perform a
simple registration.

Please include the word "Linux" in the subject line, perform
a registration using the form below, or register using the
Web forms at http://counter.li.org/ in order to register.
If you have any unusual problems - contact harald\@alvestrand.no!
EoT

            print EVENTLOG "Message ignored: No \"Linux\" in subject\n";
            print EVENTLOG "Subject was $vote\n";
	} else {
            # -------------- FIND THE USER ID --------------
	    $user = setuser($user, $replyto);
	    printheading();

	    $msg = "Your vote has been registered as: $vote";
	    $persons = FileTable::open("${prefix}persons", O_RDWR|O_CREAT);
	    $person = $persons->get($user->key, O_CREAT);
	    $countsas = $person->validator->cleanfield("usage", $vote);
	    if ($person->{method} && $person->{method} ne "simple") {
		print EVENTLOG "Vote ignored: $key already registered in form\n";
	    } else {
		$person->{method} = "simple";
		$person->{email} = $replyto;
		$person->{recdate} = $date;
		$vote =~ s/^I use Linux at //i;
		$person->{usage} = $vote;
		$person->store;
		$user->{person} = "y";
		$user->{recdate} = $date;
		$user->store;
	    }
	    print EVENTLOG "Vote recorded: $sender recorded $vote\n";
	    print EVENTLOG "Message sent back: $msg\n";
	    print MAILOUT <<EoT;
The subject line of your message is taken as the place where you use Linux.
The text found was: $vote.
This is counted as using Linux $countsas.
		    
If you want to give more detailed information, please cut out the
form below fill out the parts you want, and send it to the counter,
or use the Web pages at http://counter.li.org/.

The current statistics for the Linux counter follows below the form.
The statistics are updated twice a day.

EoT
	}
	&help;
    }
    
    print MAILOUT "\n\n";
    &includefile("reports/short") if !$reportdone;
    # Eat any remaining part of body
    while ($lastinputline) {
	&nextline;
    }
    0;
} # end onemessage

#----------------- SUBROUTINES ----------------


sub machineregistration {
    my ($machines, $machine);

    $machines = FileTable::open("${prefix}machines", O_RDWR|O_CREAT);

    $machine = $machines->new();
    print MAILOUT "//MACHINE\n";
    ($name, $fielderr, $valueerr) = &fields($machine);
    if ($machine->{name}) {
	print MAILOUT "Machine $name registered\n";
    } else {
	print MAILOUT "Machine registered using your E-mail address\n";
	$machine->{name} = $sender;
    }
    $machine->{owner} = $user->key;
    if ($machine->{name}
	&& ($oldmach = $machines->getbykey("name", $machine->{name}))
	&& $oldmach->{owner} eq $machine->{owner}) {
	$machine->setkey($oldmach->key);	
	$key = $oldmach->key;
	print EVENTLOG "Updating machine $key\n";
    } else {
	$machine->newkey();
	$key = $machine->key;
	print EVENTLOG "Creating machine $key\n";
    }
    $user->append("machines", $machine->key);
    $machine->{recdate} = $date;
    $user->{recdate} = $date;
    $machine->store();
    $user->store();
    if ($fielderr || $valueerr) {
     print MAILOUT <<EoF;
There were $fielderr unknown fields and $valueerr unknown values
You may want to register the machine again with the same name to
change these values to standard ones.
Send the command //HELP to get help with finding standard values
EoF
    }
    print MAILOUT "\n";
    print EVENTLOG "Machine registered\n";
}

sub friendregistration {
  local($name, $usage, %usages);
  
  print MAILOUT "//FRIENDS\n";
  $friends = FileTable::open("${prefix}friends", O_RDWR|O_CREAT);
  $friendcount = 0;
  while (&nextline) {
     chop;
     last if m!^//!;
     s/#.*$//;
     next if /^\s+$/;
     ($name, $usage) = split(":");
     next if (!$name || !$usage);
     if ($friendcount == 0) {
        print MACH "//Friends from $key at $date\n";
     }
     $friend = $friends->get($name, O_CREAT);
     $friend->{name} = $name;
     $friend->{usage} = $usage;
     $friend->{owner} = $user->key;
     $friend->{recdate} = $date;
     $friend->store;
     $user->append("friends", $friend->key);
     $user->store;
     ++ $friendcount;
     ++ $usages{$usage};
     print MAILOUT "$name:$usage\n";
  }
  if ($friendcount > 0) {
     print EVENTLOG "$friendcount friends registered\n";
  }
}

sub personregistration {

    $persons = FileTable::open("${prefix}persons", O_RDWR|O_CREAT);
    $person = $persons->get($user->key, O_CREAT);

    print MAILOUT "//PERSON\n";
    
    ($name, $fielderr, $valueerr) = &fields($person);
    $person->{recdate} = $date;
    $user->{recdate} = $date;
    $person->store;
    $user->{person} = "y";
    $user->store;
    print MAILOUT "Data about you has been registered\n";
    if ($fielderr || $valueerr) {
	print MAILOUT <<EoF;
There were $fielderr unknown fields and $valueerr unknown values
You may want to register your data again from the same E-mail address
to change these values to standard ones.
Send the command //HELP to get help with finding standard values
EoF
    } 
    print EVENTLOG "Person registered\n";
}

sub usergroupregistration {

    $usergroups = FileTable::open("${prefix}usergroups", O_RDWR|O_CREAT);
    
    $usergroup = $usergroups->new();
    print MAILOUT "//USERGROUP\n";
    ($name, $fielderr, $valueerr) = &fields($usergroup);
    if ($usergroup->{name}) {
	print MAILOUT "Usergroup $name registered\n";
    } else {
	print MAILOUT "Usergroup registered using your E-mail address\n";
	$usergroup->{name} = $sender;
    }
    $usergroup->{owner} = $user->key;
    $user->append("usergroups", $usergroup->key);
    if ($usergroup->{name}
	&& ($oldmach = $usergroups->getbykey("name", $usergroup->{name}))
	&& $oldmach->{owner} eq $usergroup->{owner}) {
	$usergroup->setkey($oldmach->key);	
	$key = $oldmach->key;
	print EVENTLOG "Updating usergroup $key\n";
    } else {
	$usergroup->setkey($usergroups->newnumber);
	$key = $usergroup->key;
	print EVENTLOG "Creating usergroup $key\n";
    }
    $usergroup->{recdate} = $date;
    $user->{recdate} = $date;
    $usergroup->store();
    $user->store();
    if ($fielderr || $valueerr) {
     print MAILOUT <<EoF;
There were $fielderr unknown fields and $valueerr unknown values
You may want to register the usergroup again with the same name to
change these values to standard ones.
Send the command //HELP to get help with finding standard values
EoF
    }
    print MAILOUT "\n";
    print EVENTLOG "Usergroup registered\n";
}

sub fields {
   my $rec = shift;

   my($field, $value);
   my($nosuchfield, $nosuchvalue);

   $nosuchfield = $nosuchvalue = 0;
   # MISSING: Field name validity checking

   while (&nextline) {
      chop;
      last if m!^//!;
      s/#.*$//;
      undef $field;
      undef $value;
      if (/:/) {
	  $field = $`;
	  $value = $';
      }
      next if !$field || !$value;
      # Basic field chewing
      $field =~ tr/ //d;
      $field =~ tr/A-Z/a-z/;
      $value =~ s/^\s+//;      
      $value =~ s/\s+$//;
      # Return the warmed-over record to sender
      print MAILOUT "$field:$value\n";
      # with comments, if applicable
      $check = $rec->validator->check($field, $value);
      if ($check) {
	  print MAILOUT "# NOTE: Field value is not standard\n";
	  if ($rec->validator->help($field)) {
	      print MAILOUT "# $rec->validator->help($field)\n";
	  }
	  print MAILOUT "# $check\n";
	  ++ $nosuchvalue;
      }
      $rec->{$field} = $value;
   }
   ($name, $nosuchfield, $nosuchvalue);
}

sub help {

   &includefile("email/helpfile");
   print MAILOUT  "Sorry, the record help is out of order\n";
   print MAILOUT "\n\n//END\n";
   print MAILOUT <<EoF;
The END command is only required if you have a mailer that adds stuff
below the last line of the message.
EoF
   print EVENTLOG "Help sent\n";
}

sub includefile {
   local($file) = @_;
   local($x);
   return if $reprocess;
   if (open(FILE, $file)) {
       while ($x = <FILE>) {
	   print MAILOUT $x;
       }
   } elsif (open(FILE, "$file.txt")) {
       while ($x = <FILE>) {
	   print MAILOUT $x;
       }
   } else {
       print MAILOUT ">>>>>>>>>>>File $file is not available\n";
   }
}

sub sendreport {
   local($filelist) = @_;

   &nextline;

   # Guard against file metacharacters in OPEN - limit to alphanumeric+dash
   # Allow subdir because of report country/code
   $filelist =~ tr/a-zA-Z0-9- \///cd;
   $filelist = "short" if $filelist !~ /\S/;
   @files = split(/\s+/, $filelist);
   for $file (@files) {
      next if !$file;
      if ( -f "reports/$file" || -f "reports/$file.txt") {
         print MAILOUT "------ Report $file -----------\n";
         &includefile("reports/$file");
         print EVENTLOG "Report $file sent\n";
      } else {
         print MAILOUT "Sorry, report $file does not exist\n";
         print EVENTLOG "Failed fetch on $file\n";
      }
   }
}

   
sub nextline {
   $_ = <>;
   if (/^From \S+@\S+ +\S/) {
       $fromlineofnextmessage = $_;
       $_ = "";			# Fake EOF
   }
   $echobuf .= $_;
   $lastinputline = $_;
   return $_;
}

sub notemail {
    my $replyto = shift;
    $replyto =~ tr/A-Z/a-z/; # Catch "postmaster" and "Postmaster"
    if (!&isemail($replyto)) {
	return 1;
    } elsif ($donotsendto{$replyto}) {
	$notemailbecause = "forbidden address";
	return 1;
    } elsif ($user && $user->{state} eq "blocked") {
        $notemailbecause = "blocked address - rec " . $user->key;
        return 1;
    }
    return 0;
}

# -------------- FIGURE OUT A CANDIDATE ID -------
sub setuser {

    my $user = shift;
    my $replyto = shift;

    if ($user && !isa($user, "FileTable::Record")) {
	warn "Someone's messed with user - $user keys ", keys(%{$user}), "\n";
	undef $user;
    }
    if (!$user) {
	$user = getuser($replyto);
	die "Error: getuser($replyto) failed\n" if !$user;
    }
    return $user;
}


sub getuser {
    my $sender = shift;
    my $user;
    my $key;

    $user = $users->getbykey("email", $sender);
    if ($user) {
	$key = $user->key;
	print EVENTLOG "userid is $key (old) for $sender\n";
	warn "userid is $key (old) for $sender\n";
    } else {
	$user = $users->newnum();
	$key = $user->key;
	$secret = int(100000*rand);
	$user->{key} = sprintf("%s-%05d", $user->key, $secret);
	$user->{email} = $sender;
	print EVENTLOG "userid is $key (new) for $sender\n";
	warn "userid is $key (new) for $sender\n";
    }
    $user;
}

sub printheading {

    return if $headingprinted;
    getuser() if !$user;
    my $key = $user->{key};
    my $replyto = $user->{email};
    print MAILOUT <<EoT;
Thank you for using the LINUX usage counter!
    
Your registration key is: $key
Your reply goes to:       $replyto

Your key is what you need to update information you have registered
either through email or the counter website, http://counter.li.org/

If any problem is encountered, do not hesitate to E-mail the manager:

        Harald\@Alvestrand.no

NOTE: The preferred method for accessing counter statistics and for
updating entries is the Web interface, which is available at the
URL http://counter.li.org/
Welcome!

EoT
    if ($warn) {
	print MAILOUT $warnmsg, "\n\n";
    }
    $headingprinted = 1;
}



